home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d19 / propck25.arc / SOURCE.ARC / MDOSIO.PAS < prev    next >
Pascal/Delphi Source File  |  1989-05-29  |  9KB  |  351 lines
  1.  
  2. (*
  3.  * mdosio - Mini library for interface to DOS v3 file access functions
  4.  *
  5.  * (C) 1987 Samuel H. Smith,  rev. 16-Jan-88
  6.  *
  7.  *)
  8.  
  9. {$i prodef.inc}
  10.  
  11. unit MDosIO;
  12.  
  13. interface
  14.  
  15.    uses Dos;
  16.  
  17.    type
  18.       dos_filename = string[64];
  19.       dos_handle   = word;
  20.  
  21.       long_integer = record
  22.          lsw: word;
  23.          msw: word;
  24.       end;
  25.  
  26.       seek_modes = (seek_start {0},
  27.                     seek_cur   {1},
  28.                     seek_end   {2});
  29.  
  30.       open_modes = (open_read  {h40},     {deny_nothing, allow_read}
  31.                     open_write {h41},     {deny_nothing, allow_write}
  32.                     open_update{h42});    {deny_nothing, allow_read+write}
  33.  
  34.       dos_time_functions = (time_get,
  35.                             time_set);
  36.  
  37.    const
  38.       dos_error    = $FFFF; {file handle after an error}
  39.  
  40.    var
  41.       dos_regs:     registers;
  42.       dos_name:     dos_filename;
  43.  
  44.  
  45.    procedure dos_call;
  46.  
  47.    function dos_open(name:      dos_filename;
  48.                      mode:      open_modes):  dos_handle;
  49.  
  50.    function dos_create(name:    dos_filename): dos_handle;
  51.  
  52.    function dos_read( handle:   dos_handle;
  53.                       var       buffer;
  54.                       bytes:    word): word;
  55.  
  56.    procedure dos_write(handle:  dos_handle;
  57.                        var      buffer;
  58.                        bytes:   word);
  59.  
  60.    function dos_write_failed:   boolean;
  61.  
  62.    procedure dos_lseek(handle:  dos_handle;
  63.                        offset:  longint;
  64.                        method:  seek_modes);
  65.  
  66.    procedure dos_rseek(handle:  dos_handle;
  67.                        recnum:  word;
  68.                        recsiz:  word;
  69.                        method:  seek_modes);
  70.  
  71.    function dos_tell: longint;
  72.  
  73.    procedure dos_find_eof(fd:   dos_handle);
  74.  
  75.    procedure dos_close(handle:  dos_handle);
  76.  
  77.    procedure dos_unlink(name:   dos_filename);
  78.  
  79.    procedure dos_file_times(fd:       dos_handle;
  80.                             func:     dos_time_functions;
  81.                             var time: word;
  82.                             var date: word);
  83.  
  84.    function dos_jdate(time,date: word): longint;
  85.  
  86.    function dos_exists(name: dos_filename): boolean;
  87.  
  88.  
  89. implementation
  90.  
  91. (* -------------------------------------------------------- *)
  92. procedure dos_call;
  93. var
  94.    msg:  string;
  95. begin
  96.    msdos(dos_regs);
  97.  
  98.    if (dos_regs.flags and Fcarry) <> 0 then
  99.    begin
  100.       case dos_regs.ax of
  101.          2:   msg := 'file not found';
  102.          3:   msg := 'dir not found';
  103.          4:   msg := 'too many open files';
  104.          5:   msg := 'access denied';
  105.          else str(dos_regs.ax,msg);
  106.       end;
  107. {$I-}
  108.       writeln(' DOS error [',msg,'] on file [',dos_name,'] ');
  109. {$i+}
  110.       dos_regs.ax := dos_error;
  111.    end;
  112. end;
  113.  
  114.  
  115. (* -------------------------------------------------------- *)
  116. procedure prepare_dos_name(name: dos_filename);
  117. begin
  118.    while (name <> '') and (name[length(name)] <= ' ') do
  119.       dec(name[0]);
  120.    if name = '' then
  121.       name := 'Nul';
  122.    dos_name := name;
  123.    dos_name[length(dos_name)+1] := #0;
  124.    dos_regs.ds := seg(dos_name);
  125.    dos_regs.dx := ofs(dos_name)+1;
  126. end;
  127.  
  128.  
  129. (* -------------------------------------------------------- *)
  130. function dos_open(name:    dos_filename;
  131.                   mode:    open_modes):  dos_handle;
  132. var
  133.    try: integer;
  134. const
  135.    retry_count = 3;
  136.  
  137. begin
  138.    for try := 1 to retry_count do
  139.    begin
  140.       dos_regs.ax := $3d40 + ord(mode);
  141.       prepare_dos_name(name);
  142.       msdos(dos_regs);
  143.  
  144.       if (dos_regs.flags and Fcarry) = 0 then
  145.       begin
  146.          dos_open := dos_regs.ax;
  147.          exit;
  148.       end;
  149.    end;
  150.  
  151.    dos_open := dos_error;
  152. end;
  153.  
  154.  
  155. (* -------------------------------------------------------- *)
  156. function dos_create(name:    dos_filename): dos_handle;
  157. begin
  158.    dos_regs.ax := $3c00;
  159.    prepare_dos_name(name);
  160.    dos_regs.cx := 0;   {attrib}
  161.    dos_call;
  162.    dos_create := dos_regs.ax;
  163. end;
  164.  
  165.  
  166. (* -------------------------------------------------------- *)
  167. function dos_read( handle:  dos_handle;
  168.                    var      buffer;
  169.                    bytes:   word): word;
  170. begin
  171.    dos_regs.ax := $3f00;
  172.    dos_regs.bx := handle;
  173.    dos_regs.cx := bytes;
  174.    dos_regs.ds := seg(buffer);
  175.    dos_regs.dx := ofs(buffer);
  176.    dos_call;
  177.    dos_read := dos_regs.ax;
  178. end;
  179.  
  180.  
  181. (* -------------------------------------------------------- *)
  182. procedure dos_write(handle:  dos_handle;
  183.                     var      buffer;
  184.                     bytes:   word);
  185. begin
  186.    dos_regs.ax := $4000;
  187.    dos_regs.bx := handle;
  188.    dos_regs.cx := bytes;
  189.    dos_regs.ds := seg(buffer);
  190.    dos_regs.dx := ofs(buffer);
  191.    dos_call;
  192.    dos_regs.cx := bytes;
  193. end;
  194.  
  195. function dos_write_failed: boolean;
  196. begin
  197.    dos_write_failed := dos_regs.ax <> dos_regs.cx;
  198. end;
  199.  
  200.  
  201. (* -------------------------------------------------------- *)
  202. procedure dos_lseek(handle:  dos_handle;
  203.                     offset:  longint;
  204.                     method:  seek_modes);
  205. var
  206.    pos:  long_integer absolute offset;
  207.  
  208. begin
  209.    dos_regs.ax := $4200 + ord(method);
  210.    dos_regs.bx := handle;
  211.    dos_regs.cx := pos.msw;
  212.    dos_regs.dx := pos.lsw;
  213.    dos_call;
  214. end;
  215.  
  216.  
  217. (* -------------------------------------------------------- *)
  218. procedure dos_rseek(handle:  dos_handle;
  219.                     recnum:  word;
  220.                     recsiz:  word;
  221.                     method:  seek_modes);
  222. var
  223.    offset: longint;
  224.    pos:    long_integer absolute offset;
  225.  
  226. begin
  227.    offset := longint(recnum) * longint(recsiz);
  228.    dos_regs.ax := $4200 + ord(method);
  229.    dos_regs.bx := handle;
  230.    dos_regs.cx := pos.msw;
  231.    dos_regs.dx := pos.lsw;
  232.    dos_call;
  233. end;
  234.  
  235.  
  236. (* -------------------------------------------------------- *)
  237. function dos_tell: longint;
  238.   {call immediately after dos_lseek or dos_rseek}
  239. var
  240.    pos:  long_integer;
  241.    li:   longint absolute pos;
  242. begin
  243.    pos.lsw := dos_regs.ax;
  244.    pos.msw := dos_regs.dx;
  245.    dos_tell := li;
  246. end;
  247.  
  248.  
  249. (* -------------------------------------------------------- *)
  250. procedure dos_find_eof(fd: dos_handle);
  251.    {find end of file, skip backward over ^Z eof markers}
  252. var
  253.    b: char;
  254.    n: word;
  255.    i: word;
  256.    p: longint;
  257.    temp: array[1..128] of char;
  258.  
  259. begin
  260.    dos_lseek(fd,0,seek_end);
  261.    p := dos_tell-1;
  262.    if p < 0 then
  263.       exit;
  264.  
  265.    p := p and $FFFF80;   {round to last 'sector'}
  266.    {search forward for the eof marker}
  267.    dos_lseek(fd,p,seek_start);
  268.    n := dos_read(fd,temp,sizeof(temp));
  269.    i := 1;
  270.  
  271.    while (i <= n) and (temp[i] <> ^Z) do
  272.    begin
  273.       inc(i);
  274.       inc(p);
  275.    end;
  276.  
  277.    {backup to overwrite the eof marker}
  278.    dos_lseek(fd,p,seek_start);
  279. end;
  280.  
  281.  
  282. (* -------------------------------------------------------- *)
  283. procedure dos_close(handle:  dos_handle);
  284. begin
  285.    dos_regs.ax := $3e00;
  286.    dos_regs.bx := handle;
  287.    msdos(dos_regs);  {dos_call;}
  288. end;
  289.  
  290.  
  291. (* -------------------------------------------------------- *)
  292. procedure dos_unlink(name:    dos_filename);
  293.    {delete a file, no error message if file doesn't exist}
  294. begin
  295.    dos_regs.ax := $4100;
  296.    prepare_dos_name(name);
  297.    msdos(dos_regs);
  298. end;
  299.  
  300.  
  301. (* -------------------------------------------------------- *)
  302. procedure dos_file_times(fd:       dos_handle;
  303.                          func:     dos_time_functions;
  304.                          var time: word;
  305.                          var date: word);
  306. begin
  307.    dos_regs.ax := $5700 + ord(func);
  308.    dos_regs.bx := fd;
  309.    dos_regs.cx := time;
  310.    dos_regs.dx := date;
  311.    dos_call;
  312.    time := dos_regs.cx;
  313.    date := dos_regs.dx;
  314. end;
  315.  
  316.  
  317. (* -------------------------------------------------------- *)
  318. function dos_jdate(time,date: word): longint;
  319. begin
  320.  
  321. (***
  322.      write(' d=',date:5,' t=',time:5,' ');
  323.      write('8',   (date shr 9) and 127:1); {year}
  324.      write('/',   (date shr 5) and  15:2); {month}
  325.      write('/',   (date      ) and  31:2); {day}
  326.      write(' ',   (time shr 11) and 31:2); {hour}
  327.      write(':',   (time shr  5) and 63:2); {minute}
  328.      write(':',   (time shl  1) and 63:2); {second}
  329.      writeln(' j=', (longint(date) shl 16) + longint(time));
  330.  ***)
  331.  
  332.    dos_jdate := (longint(date) shl 16) + longint(time);
  333. end;
  334.  
  335.  
  336. (* -------------------------------------------------------- *)
  337. function dos_exists(name: dos_filename): boolean;
  338. var
  339.    DirInfo:     SearchRec;
  340.  
  341. begin
  342.    prepare_dos_name(name);
  343.    FindFirst(dos_name,$21,DirInfo);
  344.    if (DosError <> 0) then
  345.       dos_exists := false
  346.    else
  347.       dos_exists := true;
  348. end;
  349.  
  350. end.
  351.